home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / ICONX_FO / FSYS.C < prev    next >
Text File  |  1990-04-01  |  24KB  |  1,142 lines
  1. /*
  2.  * File: fsys.c
  3.  *  Contents: close, exit, getenv, open, read, reads, remove, rename, [save],
  4.  *   seek, stop, [system], where, write, writes, [getch, getche, kbhit]
  5.  */
  6.  
  7. #include "::h:config.h"
  8. #include "::h:rt.h"
  9. #include "rproto.h"
  10.  
  11. #ifdef PreProcess
  12. /* include(../M4/fncs.m4) /* */
  13. /* */
  14. #endif                    /* PreProcess */
  15.  
  16. #if MICROSOFT || SCO_XENIX
  17. #define BadCode
  18. #endif                    /* MICROSOFT || SCO_XENIX */
  19.  
  20. #ifdef XENIX_386
  21. #define register
  22. #endif                    /* XENIX_386 */
  23.  
  24. #if MACINTOSH
  25. #if MPW
  26. #include <FCntl.h>
  27. #include <IOCtl.h>
  28. #include <Files.h>
  29. #define isatty(fd) (!ioctl((fd), FIOINTERACTIVE))
  30. /*
  31.  * myfflush() -- Permits environment variable option as to whether
  32.  * console output should be automatically flushed after each line of
  33.  * output.
  34.  */
  35. int
  36. myfflush(f)
  37. FILE *f;
  38.    {
  39.    static short initialized = 0;
  40.    static short nolineflush;
  41.  
  42.    if (!initialized) {
  43.       initialized = 1;
  44.       nolineflush = getenv("NOLINEFLUSH") != NULL;
  45.       }
  46.    return nolineflush ? 0 : fflush(f);
  47.    }
  48. #define fflush(f) (myfflush(f))
  49. #endif                    /* MPW */
  50. #endif                    /* MACINTOSH */
  51.  
  52. /*
  53.  * close(f) - close file f.
  54.  */
  55.  
  56. FncDcl(close,1)
  57.    {
  58.    FILE *f;
  59.  
  60.    /*
  61.     * Arg1 must be a file.
  62.     */
  63.    if (Arg1.dword != D_File) 
  64.       RunErr(105, &Arg1);
  65.  
  66.    /*
  67.     * Close Arg1, using fclose or pclose as appropriate.
  68.     */
  69.  
  70. #if UNIX || VMS
  71.    if (BlkLoc(Arg1)->file.status & Fs_Pipe) {
  72.       BlkLoc(Arg1)->file.status = 0;
  73.       MakeInt((long)((pclose(BlkLoc(Arg1)->file.fd) >> 8) & 0377), &Arg0);
  74.       Return;
  75.       }
  76.    else
  77. #endif                    /* UNIX || VMS */
  78.  
  79.       f = BlkLoc(Arg1)->file.fd;
  80.  
  81.    fclose(f);
  82.    BlkLoc(Arg1)->file.status = 0;
  83.  
  84.    /*
  85.     * Return the closed file.
  86.     */
  87.    Arg0 = Arg1;
  88.    Return;
  89.    }
  90.  
  91. /*
  92.  * exit(status) - exit process with specified status, defaults to 0.
  93.  */
  94.  
  95. FncDcl(exit,1)
  96.    {
  97.    if (defshort(&Arg1, NormalExit) == Error) 
  98.       RunErr(0, NULL);
  99.    c_exit((int)IntVal(Arg1));
  100.    }
  101.  
  102. /*
  103.  * getenv(s) - return contents of environment variable s
  104.  */
  105.  
  106. FncDcl(getenv,1)
  107.    {
  108.  
  109. #ifndef EnvVars
  110.    RunErr(-121, NULL);
  111. #else                    /* EnvVars */
  112.  
  113.    register char *p;
  114.    register word len;
  115.    char sbuf[256];
  116.  
  117.  
  118.    /*
  119.     * Make a C-style string out of Arg1
  120.     */
  121.    switch (cvstr(&Arg1, sbuf)) {
  122.  
  123.       case Cvt:   /* Already converted to a C-style string */
  124.          break;
  125.  
  126.       case NoCvt:
  127.          qtos(&Arg1, sbuf);
  128.          break;
  129.  
  130.       default:
  131.          RunErr(103, &Arg1);
  132.       }
  133.  
  134.    if ((p = getenv(StrLoc(Arg1))) != NULL) {    /* get environment variable */
  135.       len = strlen(p);
  136.       if (strreq(len) == Error) 
  137.          RunErr(0, NULL);
  138.       StrLen(Arg0) = len;
  139.       StrLoc(Arg0) = alcstr(p, len);
  140.       Return;
  141.       }
  142.    else                 /* fail if not in environment */
  143.       Fail;
  144. #endif                    /* EnvVars */
  145.    }
  146.  
  147. /*
  148.  * open(s1,s2) - open file s1 with specification s2.
  149.  */
  150. FncDcl(open,2)
  151.    {
  152.    register word slen;
  153.    register int i;
  154.    register char *s;
  155.    int status;
  156.    char mode[4];
  157.    extern FILE *fopen();
  158.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  159.    char *openstring;
  160.    FILE *f;
  161.  
  162. /*
  163.  * The following code is operating-system dependent [@fsys.01].  Make
  164.  *  declarations as needed for opening files.
  165.  */
  166.  
  167. #if PORT
  168. Deliberate Syntax Error
  169. #endif                    /* PORT */
  170.  
  171. #if AMIGA || MVS || VM
  172.    /* nothing is needed */
  173. #endif                    /* AMIGA || MACINTOSH */
  174.  
  175. #if ATARI_ST || HIGHC_386 || MSDOS || OS2
  176.    char untranslated;
  177. #endif                    /* ATARI_ST || HIGHC_386 || ... */
  178.  
  179. #if MACINTOSH
  180. #if LSC
  181.    char untranslated;
  182. #endif                    /* LSC */
  183. #endif                    /* MACINTOSH */
  184.  
  185. #if UNIX || VMS
  186.    extern FILE *popen();
  187. #endif                    /* UNIX || VMS */
  188.  
  189. /*
  190.  * End of operating-system specific code.
  191.  */
  192.  
  193.  
  194.    /*
  195.     * Arg1 must be a string and a C string copy of it is also needed.
  196.     *  Make it a string if it is not one; make a C string if Arg1 is
  197.     *  a string.
  198.     */
  199.    switch (cvstr(&Arg1, sbuf1)) {
  200.  
  201.       case Cvt:
  202.          openstring = StrLoc(Arg1);
  203.          if (strreq(StrLen(Arg1)) == Error) 
  204.             RunErr(0, NULL);
  205.          StrLoc(Arg1) = alcstr(StrLoc(Arg1), StrLen(Arg1));
  206.          break;
  207.  
  208.       case NoCvt:
  209.          tended[1] = Arg1;
  210.          ntended = 1;
  211.          qtos(&tended[1], sbuf1);
  212.          openstring = StrLoc(tended[1]);
  213.          break;
  214.  
  215.       default:
  216.          RunErr(103, &Arg1);
  217.       }
  218.    /*
  219.     * s2 defaults to "r".
  220.     */
  221.    if (defstr(&Arg2, sbuf2, &letr) == Error) 
  222.       RunErr(0, NULL);
  223.  
  224.    if (blkreq((word)sizeof(struct b_file)) == Error) 
  225.       RunErr(0, NULL);
  226.    status = 0;
  227.  
  228. /*
  229.  * The following code is operating-system dependent [@fsys.02].  Provide
  230.  *  declaration for untranslated line-termination mode, if supported.
  231.  */
  232.  
  233. #if PORT
  234.    /* nothing to do */
  235. Deliberate Syntax Error
  236. #endif                    /* PORT */
  237.  
  238. #if AMIGA
  239.    /* translated mode could be supported, but is not now */
  240. #endif                    /* AMIGA */
  241.  
  242. #if ATARI_ST || HIGHC_386 || MSDOS || OS2
  243.    untranslated = 0;
  244. #endif                    /* ATARI_ST || HIGHC_386 || ... */
  245.  
  246. #if MACINTOSH
  247. #if LSC
  248.    untranslated = 0;
  249. #endif                    /* LSC */
  250. #endif                    /* MACINTOSH */
  251.  
  252. #if MVS || UNIX || VM || VMS
  253.    /* nothing to do */
  254. #endif                    /* UNIX || VMS */
  255.  
  256. /*
  257.  * End of operating-system specific code.
  258.  */
  259.  
  260.    /*
  261.     * Scan Arg2, setting appropriate bits in status.  Produce a run-time error
  262.     *  if an unknown character is encountered.
  263.     */
  264.    s = StrLoc(Arg2);
  265.    slen = StrLen(Arg2);
  266.    for (i = 0; i < slen; i++) {
  267.       switch (*s++) {
  268.          case 'a':
  269.          case 'A':
  270.             status |= Fs_Write|Fs_Append;
  271.             continue;
  272.          case 'b':
  273.          case 'B':
  274.             status |= Fs_Read|Fs_Write;
  275.             continue;
  276.          case 'c':
  277.          case 'C':
  278.             status |= Fs_Create|Fs_Write;
  279.             continue;
  280.          case 'r':
  281.          case 'R':
  282.             status |= Fs_Read;
  283.             continue;
  284.          case 'w':
  285.          case 'W':
  286.             status |= Fs_Write;
  287.             continue;
  288.  
  289. /*
  290.  * The following code is operating-system dependent [@fsys.03].  Handle
  291.  * untranslated line-terminator mode and pipes, if supported.
  292.  */
  293.  
  294. #if PORT
  295.          case 't':
  296.          case 'T':
  297.          case 'u':
  298.          case 'U':
  299.             continue;            /* no-op */
  300. Deliberate Syntax Error
  301. #endif                    /* PORT */
  302.  
  303. #if AMIGA || MVS || VM
  304.          case 't':
  305.          case 'T':
  306.          case 'u':
  307.          case 'U':
  308.             continue;            /* no-op */
  309. #endif                    /* AMIGA || MVS || VM */
  310.  
  311. #if ATARI_ST || HIGHC_386 || MSDOS || OS2
  312.          case 't':
  313.          case 'T':
  314.             untranslated = 0;
  315.             continue;
  316.          case 'u':
  317.          case 'U':
  318.             untranslated = 1;
  319.             continue;
  320. #endif                    /* ATARI_ST || HIGHC_386 || ... */
  321.  
  322. #if MACINTOSH
  323. #if LSC
  324.          case 't':
  325.          case 'T':
  326.             untranslated = 0;
  327.             continue;
  328.          case 'u':
  329.          case 'U':
  330.             untranslated = 1;
  331.             continue;
  332. #endif                    /* LSC */
  333. #endif                    /* MACINTOSH */
  334.  
  335. #if UNIX || VMS
  336.          case 't':
  337.          case 'T':
  338.          case 'u':
  339.          case 'U':
  340.             continue;            /* no-op */
  341.          case 'p':
  342.          case 'P':
  343.             status |= Fs_Pipe;
  344.             continue;
  345. #endif                    /* UNIX || VMS */
  346.  
  347. /*
  348.  * End of operating-system specific code.
  349.  */
  350.          default:
  351.             RunErr(209, &Arg2);
  352.          }
  353.       }
  354.  
  355.    /*
  356.     * Construct a mode field for fopen/popen.
  357.     */
  358.    mode[0] = '\0';
  359.    mode[1] = '\0';
  360.    mode[2] = '\0';
  361.    mode[3] = '\0';
  362.  
  363.    if ((status & (Fs_Read|Fs_Write)) == 0)   /* default: read only */
  364.       status |= Fs_Read;
  365.    if (status & Fs_Create)
  366.       mode[0] = 'w';
  367.    else if (status & Fs_Append)
  368.       mode[0] = 'a';
  369.    else if (status & Fs_Read)
  370.       mode[0] = 'r';
  371.    else
  372.       mode[0] = 'w';
  373.  
  374. /*
  375.  * The following code is operating-system dependent [@fsys.04].  Handle open
  376.  *  modes.
  377.  */
  378.  
  379. #if PORT
  380.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write))
  381.       mode[1] = '+';
  382. Deliberate Syntax Error
  383. #endif                    /* PORT */
  384.  
  385. #if ATARI_ST
  386.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  387.       mode[1] = '+';
  388.       mode[2] = untranslated ? 'b' : 'a';
  389.       }
  390.    else mode[1] = untranslated ? 'b' : 'a';
  391. #endif                    /* ATARI_ST */
  392.  
  393. #if HIGHC_386 || OS2
  394.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  395.       mode[1] = '+';
  396.       mode[2] = untranslated ? 'b' : 't';
  397.       }
  398.    else mode[1] = untranslated ? 'b' : 't';
  399. #endif                    /* HIGHC_386 || OS2 */
  400.  
  401. #if MACINTOSH
  402. #if LSC
  403.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  404.       mode[1] = '+';
  405.       if (untranslated)
  406.          mode[2] = 'b';
  407.       }
  408.    else if (untranslated)
  409.       mode[1] = 'b';
  410. #endif                    /* LSC */
  411. #endif                    /* MACINTOSH */
  412.  
  413. #if MSDOS
  414. #if MICROSOFT || TURBO
  415.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  416.       mode[1] = '+';
  417.       mode[2] = untranslated ? 'b' : 't';
  418.       }
  419.    else mode[1] = untranslated ? 'b' : 't';
  420. #endif                    /* MICROSOFT || TURBO */
  421. #if LATTICE || MWC
  422.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  423.       mode[1] = '+';
  424.       if (untranslated)
  425.          mode[2] = 'b';
  426.       }
  427.    else if (untranslated)
  428.       mode[1] = 'b';
  429. #endif                    /* LATTICE || MWC */
  430. #endif                    /* HIGHC_386 || MSDOS */
  431.  
  432. #if AMIGA || MACINTOSH || MVS || UNIX || VM || VMS
  433.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write))
  434.       mode[1] = '+';
  435. #endif                    /* AMIGA || MACINTOSH || UNIX || VMS */
  436.  
  437. /*
  438.  * End of operating-system specific code.
  439.  */
  440.  
  441.    /*
  442.     * Open the file with fopen or popen.
  443.     */
  444.  
  445. #if UNIX || VMS
  446.    if (status & Fs_Pipe) {
  447.       if (status != (Fs_Read|Fs_Pipe) && status != (Fs_Write|Fs_Pipe)) 
  448.          RunErr(209, &Arg2);
  449.       f = popen(openstring, mode);
  450.       }
  451.    else
  452. #endif                    /* UNIX || VMS */
  453.  
  454.       f = fopen(openstring, mode);
  455.    /*
  456.     * Fail if the file cannot be opened.
  457.     */
  458.    if (f == NULL)
  459.       Fail;
  460.  
  461. #if MACINTOSH
  462. #if MPW
  463. /* Set file type and creator. */
  464.    {
  465.    FInfo info;
  466.  
  467.    if (getfinfo(openstring,0,&info) == 0) {
  468.       if (status & Fs_Write && info.fdType == 0 && info.fdCreator == 0) {
  469.      info.fdType = 'TEXT';
  470.      info.fdCreator = 'MPS ';
  471.      setfinfo(openstring,0,&info);
  472.      }
  473.       }
  474.    }
  475. #endif                    /* MPW */
  476. #endif                    /* MACINTOSH */
  477.  
  478.    /*
  479.     * Return the resulting file value.
  480.     */
  481.    Arg0.dword = D_File;
  482.    BlkLoc(Arg0) = (union block *) alcfile(f, status, &Arg1);
  483.    ntended = 0;
  484.    Return;
  485.    }
  486.  
  487. /*
  488.  * read(f) - read line on file f.
  489.  */
  490. FncDcl(read,1)
  491.    {
  492.    register word slen, rlen;
  493.    register char *sp;
  494.    int status;
  495.    static char sbuf[MaxReadStr];
  496.    FILE *f;
  497.  
  498.    /*
  499.     * Default Arg1 to &input.
  500.     */
  501.    if (deffile(&Arg1, &input) == Error) 
  502.       RunErr(0, NULL);
  503.  
  504.    /*
  505.     * Get a pointer to the file and be sure that it is open for reading.
  506.     */
  507.    f = BlkLoc(Arg1)->file.fd;
  508.    status = (int)BlkLoc(Arg1)->file.status;
  509.    if ((status & Fs_Read) == 0) 
  510.       RunErr(212, &Arg1);
  511.  
  512.    /*
  513.     * Use getstrg to read a line from the file, failing if getstrg
  514.     *  encounters end of file. [[ What about -2?]]
  515.     */
  516.    StrLen(Arg0) = 0;
  517.    do {
  518.       if ((slen = getstrg(sbuf,MaxReadStr,f)) == -1)
  519.          Fail;
  520.       /*
  521.        * Allocate the string read and make Arg0 a descriptor for it.
  522.        */
  523.       rlen = slen < 0 ? (word)MaxReadStr : slen;
  524.       if (strreq(rlen) == Error) 
  525.          RunErr(0, NULL);
  526.       sp = alcstr(sbuf,rlen);
  527.       if (StrLen(Arg0) == 0)
  528.          StrLoc(Arg0) = sp;
  529.       StrLen(Arg0) += rlen;
  530.       } while (slen < 0);
  531.    Return;
  532.    }
  533.  
  534. /*
  535.  * reads(f,i) - read i characters on file f.
  536.  */
  537. FncDcl(reads,2)
  538.    {
  539.    register word cnt;
  540.    long tally;
  541.    int status;
  542.    FILE *f;
  543.  
  544.    /*
  545.     * Arg1 defaults to &input and Arg2 defaults to 1 (character).
  546.     */
  547.    if ((deffile(&Arg1, &input) == Error) ||
  548.        (defshort(&Arg2, 1) == Error)) 
  549.       RunErr(0, NULL);
  550.  
  551.    /*
  552.     * Get a pointer to the file and be sure that it is open for reading.
  553.     */
  554.    f = BlkLoc(Arg1)->file.fd;
  555.    status = (int)BlkLoc(Arg1)->file.status;
  556.    if ((status & Fs_Read) == 0) 
  557.       RunErr(212, &Arg1);
  558.  
  559.    /*
  560.     * Be sure that a positive number of bytes is to be read.
  561.     */
  562.    if ((cnt = IntVal(Arg2)) <= 0) 
  563.       RunErr(205, &Arg2);
  564.  
  565.    /*
  566.     * Ensure that enough space for the string exists and read it directly
  567.     *  into the string space.  (By reading directly into the string space,
  568.     *  no arbitrary restrictions are placed on the size of the string that
  569.     *  can be read.)  Make Arg0 a descriptor for the string and return it.
  570.     */
  571.    if (strreq(cnt) == Error) 
  572.       RunErr(0, NULL);
  573.    if (strfree + cnt > strend)
  574.       syserr("reads allocation botch");
  575.    StrLoc(Arg0) = strfree;
  576.  
  577. #if AMIGA
  578.    /*
  579.     * The following code is special for Lattice 4.0 -- it was different
  580.     *  for Lattice 3.10.  It probably won't work correctly with other
  581.     *  C compilers.
  582.     */
  583.    if (IsInteractive(_ufbs[fileno(f)].ufbfh)) {
  584.       if ((cnt = read(fileno(f),StrLoc(Arg0),cnt)) <= 0)
  585.          Fail;
  586.       StrLen(Arg0) = cnt;
  587.       alcstr(NULL, cnt);
  588.       Return;
  589.       }
  590. #endif                    /* AMIGA */
  591.  
  592.    tally = longread(StrLoc(Arg0),sizeof(char),cnt,f);
  593.    if (tally == 0)
  594.       Fail;
  595.    StrLen(Arg0) = tally;
  596.    alcstr(NULL, (word)tally);
  597.    Return;
  598.    }
  599.  
  600. /*
  601.  * remove(s) - remove the file named s.
  602.  */
  603.  
  604. FncDcl(remove,1)
  605.    {
  606.    char sbuf[MaxCvtLen];
  607.  
  608.    /*
  609.     * Make a C-style string out of Arg1
  610.     */
  611.    switch (cvstr(&Arg1, sbuf)) {
  612.  
  613.       case Cvt:   /* Already converted to a C-style string */
  614.          break;
  615.  
  616.       case NoCvt:
  617.          qtos(&Arg1, sbuf);
  618.          break;
  619.  
  620.       default:
  621.          RunErr(103, &Arg1);
  622.       }
  623.    if (unlink(StrLoc(Arg1)) != 0)
  624.       Fail;
  625.    Arg0 = nulldesc;
  626.    Return;
  627.    }
  628.  
  629. /*
  630.  * rename(s1,s2) - rename the file named s1 to have the name s2.
  631.  */
  632.  
  633. FncDcl(rename,2)
  634.    {
  635.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  636.  
  637.    /*
  638.     * Make a C-style string out of Arg1
  639.     */
  640.    switch (cvstr(&Arg1, sbuf1)) {
  641.  
  642.       case Cvt:   /* Already converted to a C-style string */
  643.          break;
  644.  
  645.       case NoCvt:
  646.          qtos(&Arg1, sbuf1);
  647.          break;
  648.  
  649.       default:
  650.          RunErr(103, &Arg1);
  651.       }
  652.  
  653.    /*
  654.     * Make a C-style string out of Arg2
  655.     */
  656.    switch (cvstr(&Arg2, sbuf2)) {
  657.  
  658.       case Cvt:   /* Already converted to a C-style string */
  659.          break;
  660.  
  661.       case NoCvt:
  662.          qtos(&Arg2, sbuf2);
  663.          break;
  664.  
  665.       default:
  666.          RunErr(103, &Arg2);
  667.       }
  668.  
  669. /*
  670.  * The following code is operating-system dependent [@fsys.05].  Rename the
  671.  *  file, and fail if unsuccessful.
  672.  */
  673.  
  674. #if PORT
  675.    /* need something */
  676. Deliberate Syntax Error
  677. #endif                    /* PORT */
  678.  
  679. #if AMIGA || ATARI_ST || HIGHC_386 || MACINTOSH || MSDOS || MVS || OS2 || VM || VMS
  680.    {
  681.    if (rename(StrLoc(Arg1),StrLoc(Arg2)) != 0)
  682.       Fail;
  683.    }
  684. #endif                    /* AMIGA || ATARI_ST ... */
  685.  
  686. #if UNIX
  687.    if (link(StrLoc(Arg1),StrLoc(Arg2)) != 0)
  688.       Fail;
  689.    if (unlink(StrLoc(Arg1)) != 0) {
  690.       unlink(StrLoc(Arg2));    /* try to undo partial rename */
  691.       Fail;
  692.       }
  693. #endif                    /* UNIX */
  694.  
  695. /*
  696.  * End of operating-system specific code.
  697.  */
  698.  
  699.    Arg0 = nulldesc;
  700.    Return;
  701.    }
  702.  
  703. #ifdef ExecImages
  704. /*
  705.  * save(s) - save the run-time system in file s
  706.  */
  707.  
  708. FncDcl(save,1)
  709.    {
  710.    char sbuf[MaxCvtLen];
  711.    int f, fsz;
  712.  
  713.    dumped = 1;
  714.  
  715.    /* if (ChkNull(Arg1)) { abort(); } */
  716.  
  717.    /*
  718.     * Make a C-style string out of Arg1.
  719.     */
  720.    switch (cvstr(&Arg1, sbuf)) {
  721.  
  722.       case Cvt:   /* Already converted to a C-style string */
  723.          break;
  724.  
  725.       case NoCvt:
  726.          qtos(&Arg1, sbuf);
  727.          break;
  728.  
  729.       default:
  730.          RunErr(103, &Arg1);
  731.       }
  732.  
  733.  
  734.    /*
  735.     * Open the file for the executable image.
  736.     */
  737.    f = creat(StrLoc(Arg1), 0777);
  738.    if (f == -1)
  739.       Fail;
  740.    fsz = wrtexec(f);
  741.    /*
  742.     * It happens that most wrtexecs don't check the system call return
  743.     *  codes and thus they'll never return -1.  Nonetheless...
  744.     */
  745.    if (fsz == -1)
  746.       Fail;
  747.    /*
  748.     * Return the size of the data space.
  749.     */
  750.    MakeInt(fsz, &Arg0);
  751.    Return;
  752.    }
  753.  
  754. #endif                    /* ExecImages */
  755.  
  756. /*
  757.  * seek(file,position) - seek to byte byte position in file.
  758.  *  [[ What about seek error ? ]]
  759.  */
  760.  
  761. FncDcl(seek,2)
  762.    {
  763.    long l1;
  764.    FILE *fd;
  765.  
  766.    if (Arg1.dword != D_File) 
  767.       RunErr(-105, NULL);
  768.  
  769.    if (defint(&Arg2, &l1, 1L) == Error)
  770.       RunErr(0, NULL);
  771.  
  772.    fd = BlkLoc(Arg1)->file.fd;
  773.  
  774.    if (BlkLoc(Arg1)->file.status == 0)
  775.       Fail;
  776.     if (l1 > 0) {
  777.        if (fseek(fd, l1 - 1, 0) == -1)
  778.           Fail;
  779.        }
  780.     else {
  781.        if (fseek(fd, l1, 2) == -1)
  782.           Fail;
  783.        }
  784.    Arg0 = Arg1;
  785.    Return;
  786.    }
  787.  
  788. /*
  789.  * stop(a,b,...) - write arguments (starting on error output) and stop.
  790.  */
  791.  
  792. FncDclV(stop)
  793.     {
  794.    register word n;
  795.    char sbuf[MaxCvtLen];
  796.    FILE *f;
  797.  
  798. #ifdef BadCode
  799.    struct descrip temp;
  800. #endif                    /* BadCode */
  801.  
  802.    f = stderr;
  803.    ntended = 0;
  804.    /*
  805.     * Loop through arguments.
  806.     */
  807.  
  808.    for (n = 1; n <= nargs; n++) {
  809.  
  810. #ifdef BadCode 
  811.       temp = Arg(n);            /* workaround for Microsoft C bug */
  812.       tended[1] = temp;
  813. #else                    /* BadCode */
  814.       tended[1] = Arg(n);
  815. #endif                    /* BadCode */
  816.  
  817.       if (tended[1].dword == D_File) {
  818.          if (n > 1)
  819.             putc('\n', f);
  820.          if ((BlkLoc(tended[1])->file.status & Fs_Write) == 0) 
  821.             RunErr(213, &tended[1]);
  822.          f = BlkLoc(tended[1])->file.fd;
  823.          }
  824.       else {
  825.          if (n == 1 && (k_output.status & Fs_Write) == 0) 
  826.             RunErr(-213, NULL);
  827.          if (ChkNull(tended[1]))
  828.             tended[1] = emptystr;
  829.          if (cvstr(&tended[1], sbuf) == CvtFail) 
  830.             RunErr(109, &tended[1]);
  831.          putstr(f, &tended[1]);
  832.          }
  833.       }
  834.  
  835.    putc('\n', f);
  836.    fflush(f);
  837.    c_exit(ErrorExit);
  838.    }
  839.  
  840. #ifdef SystemFnc
  841. /*
  842.  * system(s) - execute string s as a system command.
  843.  */
  844.  
  845. FncDcl(system,1)
  846.    {
  847.    char sbuf[MaxCvtLen];
  848.    char *systemstring;
  849.  
  850.    /*
  851.     * Make a C-style string out of Arg1
  852.     */
  853.    switch (cvstr(&Arg1, sbuf)) {
  854.  
  855.       case Cvt:   /* Already converted to a C-style string */
  856.          break;
  857.  
  858.       case NoCvt:
  859.          qtos(&Arg1, sbuf);
  860.          break;
  861.  
  862.       default:
  863.          RunErr(103, &Arg1);
  864.       }
  865.       systemstring = StrLoc(Arg1);
  866.  
  867.    /*
  868.     * Pass the C string to the system() function and return the exit code
  869.     *  of the command as the result of system().
  870.     */
  871.  
  872. /*
  873.  * The following code is operating-system dependent [@fsys.06].  Perform system
  874.  *  call.  Should not get here unless system(s) is supported.
  875.  */
  876.  
  877. #if PORT
  878. Deliberate Syntax Error
  879. #endif                    /* PORT */
  880.  
  881. #if AMIGA || MSDOS || OS2 || UNIX
  882.    MakeInt((long)((system(systemstring) >> 8) & 0377), &Arg0);
  883. #endif                    /* AMIGA || MSDOS || ... */
  884.  
  885. #if ATARI_ST || VMS
  886.    MakeInt(system(systemstring), &Arg0);
  887. #endif                    /* ATARI_ST || VMS */
  888.  
  889. #if HIGHC_386 || MACINTOSH
  890.    /* Should not get here */
  891. #endif                    /* HIGHC_386 || MACINTOSH */
  892.  
  893. #if MVS || VM
  894.    MakeInt((long)system(systemstring), &Arg0);
  895. #endif                    /* MVS || VM */
  896.  
  897. /*
  898.  * End of operating-system specific code.
  899.  */
  900.    Return;
  901.    }
  902.  
  903. #endif                    /* SystemFnc */
  904. /*
  905.  * where(file) - return current offset position in file.
  906.  */
  907.  
  908. FncDcl(where,1)
  909.    {
  910.    FILE *fd;
  911.    long ftell();
  912.  
  913.    if (Arg1.dword != D_File) 
  914.       RunErr(-105, NULL);
  915.  
  916.    fd = BlkLoc(Arg1)->file.fd;
  917.  
  918.    if ((BlkLoc(Arg1)->file.status == 0))
  919.       Fail;
  920.  
  921.    MakeInt(ftell(fd) + 1, &Arg0);
  922.    Return;
  923.    }
  924.  
  925. /*
  926.  * write(a,b,...) - write arguments.
  927.  */
  928. FncDclV(write)
  929.    {
  930.    register word n;
  931.    char sbuf[MaxCvtLen];
  932.    FILE *f;
  933.  
  934. #ifdef BadCode
  935.    struct descrip temp;
  936. #endif                    /* BadCode */
  937.  
  938.    f = stdout;
  939.    ntended = 1;
  940.    tended[1] = emptystr;
  941.  
  942.    /*
  943.     * Loop through the arguments.
  944.     */
  945.    for (n = 1; n <= nargs; n++) {
  946.  
  947. #ifdef BadCode
  948.       temp = Arg(n);            /* workaround for Microsoft bug */
  949.       tended[1] = temp;
  950. #else                    /* BadCode */
  951.       tended[1] = Arg(n);
  952. #endif                    /* BadCode */
  953.  
  954.       if (tended[1].dword == D_File)    {    /* Current argument is a file */
  955.          /*
  956.           * If this is not the first argument, output a newline to the current
  957.           *  file and flush it.
  958.           */
  959.          if (n > 1) {
  960.             putc('\n', f);
  961.             fflush(f);
  962.             }
  963.          /*
  964.           * Switch the current file to the file named by the current argument
  965.           *  providing it is a file.  tended[1] is made to be a empty string to
  966.           *  avoid a special case.
  967.           */
  968.          if ((BlkLoc(tended[1])->file.status & Fs_Write) == 0) 
  969.             RunErr(213, &tended[1]);
  970.          f = BlkLoc(tended[1])->file.fd;
  971.          tended[1] = emptystr;
  972.          }
  973.       else {    /* Current argument is a string */
  974.          /*
  975.           * On first argument, check to be sure that &output is open
  976.           *  for output.
  977.           */
  978.          if (n == 1 && (k_output.status & Fs_Write) == 0) 
  979.             RunErr(-213, NULL);
  980.  
  981.          /*
  982.           * Convert the argument to a string, defaulting to a empty string.
  983.           */
  984.          if (ChkNull(tended[1]))
  985.             tended[1] = emptystr;
  986.          if (cvstr(&tended[1], sbuf) == CvtFail) 
  987.             RunErr(109, &tended[1]);
  988.  
  989.          /*
  990.           * Output the string.
  991.           */
  992.          if (putstr(f, &tended[1]) == Failure) 
  993.             RunErr(-214, NULL);
  994.          }
  995.       }
  996.    /*
  997.     * Append a newline to the file and flush it.
  998.     */
  999.    putc('\n', f);
  1000.    if (ferror(f)) 
  1001.       RunErr(-214, NULL);
  1002.  
  1003.    fflush(f);
  1004.  
  1005.    /*
  1006.     * Return the last argument.
  1007.     */
  1008.    ntended = 0;
  1009.    Arg(0) = Arg(n - 1);
  1010.    Return;
  1011.    }
  1012.  
  1013. /*
  1014.  * writes(a,b,...) - write arguments without newline terminator.
  1015.  */
  1016.  
  1017. FncDclV(writes)
  1018.    {
  1019.    register word n;
  1020.    char sbuf[MaxCvtLen];
  1021.    FILE *f;
  1022.  
  1023. #ifdef BadCode
  1024.    struct descrip temp;
  1025. #endif                    /* BadCode */
  1026.  
  1027.    f = stdout;
  1028.    ntended = 1;
  1029.    tended[1] = emptystr;
  1030.  
  1031.    /*
  1032.     * Loop through the arguments.
  1033.     */
  1034.    for (n = 1; n <= nargs; n++) {
  1035.  
  1036. #ifdef BadCode
  1037.       temp = Arg(n);            /* workaround for Microsoft bug */
  1038.       tended[1] = temp;
  1039. #else                    /* BadCode */
  1040.       tended[1] = Arg(n);
  1041. #endif                    /* BadCode */
  1042.  
  1043.       if (tended[1].dword == D_File)    {    /* Current argument is a file */
  1044.          /*
  1045.           * Switch the current file to the file named by the current argument
  1046.           *  providing it is a file.  tended[1] is made to be a empty string to
  1047.           *  avoid a special case.
  1048.           */
  1049.          if ((BlkLoc(tended[1])->file.status & Fs_Write) == 0) 
  1050.             RunErr(213, &tended[1]);
  1051.          f = BlkLoc(tended[1])->file.fd;
  1052.          tended[1] = emptystr;
  1053.          }
  1054.       else {    /* Current argument is a string */
  1055.          /*
  1056.           * On first argument, check to be sure that &output is open
  1057.           *  for output.
  1058.           */
  1059.          if (n == 1 && (k_output.status & Fs_Write) == 0) 
  1060.             RunErr(-213, NULL);
  1061.  
  1062.          /*
  1063.           * Convert the argument to a string, defaulting to a empty string.
  1064.           */
  1065.          if (ChkNull(tended[1]))
  1066.             tended[1] = emptystr;
  1067.          if (cvstr(&tended[1], sbuf) == CvtFail) 
  1068.             RunErr(109, &tended[1]);
  1069.          /*
  1070.           * Output the string and flush the file.
  1071.           */
  1072.          if (putstr(f, &tended[1]) == Failure) 
  1073.             RunErr(-214, NULL);
  1074.  
  1075. #ifndef WATERLOO_C_V3
  1076.          fflush(f);
  1077. #endif                    /* WATERLOO_C_V3 */
  1078.  
  1079.          }
  1080.       }
  1081.    /*
  1082.     * Return the last argument.
  1083.     */
  1084.    ntended = 0;
  1085.    Arg(0) = Arg(n - 1);
  1086.    Return;
  1087.    }
  1088.  
  1089. #ifdef KeyboardFncs
  1090. /*
  1091.  * getch() - return a character from console.
  1092.  */
  1093.  
  1094. FncDcl(getch,0)
  1095.    {
  1096.    unsigned char c;
  1097.    int i;
  1098.    i = getch();
  1099.    if (i<0)
  1100.       Fail;
  1101.    if (strreq((word)1) == Error)
  1102.       RunErr(0, NULL);
  1103.    c = (unsigned char) i;
  1104.    StrLoc(Arg0) = alcstr((char *)&c,(word)1);
  1105.    StrLen(Arg0) = 1;
  1106.    Return;
  1107.    }
  1108.  
  1109. /*
  1110.  * getche() -- return a character from console with echo.
  1111.  */
  1112.  
  1113. FncDcl(getche,0)
  1114.    {
  1115.    unsigned char c;
  1116.    int i;
  1117.    i = getche();
  1118.    if (i<0)
  1119.       Fail;
  1120.    if (strreq((word)1) == Error)
  1121.       RunErr(0, NULL);
  1122.    c = (unsigned char) i;
  1123.    StrLoc(Arg0) = alcstr((char *)&c,(word)1);
  1124.    StrLen(Arg0) = 1;
  1125.    Return;
  1126.    }
  1127.  
  1128. /*
  1129.  * kbhit() -- Check to see if there is a keyboard character waiting to
  1130.  *  be read.
  1131.  */
  1132.  
  1133. FncDcl(kbhit,0)
  1134.    {
  1135.    if (kbhit()) {
  1136.       Arg0 = nulldesc;
  1137.       Return;
  1138.       }
  1139.    else Fail;
  1140.    }
  1141. #endif                    /* KeyboardFncs */
  1142.